home *** CD-ROM | disk | FTP | other *** search
/ Disc to the Future 2 / Disc to the Future Part II Programmer's Reference (Wayzata Technology)(6013)(1992).bin / MAC / MPW_TOOL / TOOLS / TOOLS_WI / ICON_8 / ICONX_FO / INVOKE.C < prev    next >
Text File  |  1990-03-02  |  6KB  |  231 lines
  1. /*
  2.  * Procedure and function invocation.
  3.  */
  4.  
  5. #include <math.h>
  6. #include "::h:config.h"
  7. #include "::h:rt.h"
  8. #include "rproto.h"
  9.  
  10. #ifdef TraceBack
  11. extern dptr xargp;
  12. extern word xnargs;
  13. #endif                     /* TraceBack */
  14.  
  15. /*
  16.  * invoke -- Perform setup for invocation.  
  17.  */
  18. invoke(nargs,cargp,n)
  19. dptr *cargp;
  20. int nargs, *n;
  21. {
  22.    register struct pf_marker *newpfp;
  23.    register dptr newargp;
  24.    register word *newsp = sp;
  25.  
  26. #ifdef SCO_XENIX
  27.    register dptr p;
  28. #endif                    /* SCO_XENIX */
  29.  
  30.    register word i;
  31.    struct b_proc *proc;
  32.    int nparam;
  33.    char strbuf[MaxCvtLen];
  34.  
  35.    /*
  36.     * Point newargp at Arg0 and dereference it.
  37.     */
  38.    newargp = (dptr )(sp - 1) - nargs;
  39.  
  40. #ifdef TraceBack
  41.    xnargs = nargs;
  42.    xargp = newargp;
  43. #endif                    /* TraceBack */
  44.  
  45.    if (DeRef(newargp[0]) == Error) {
  46.       runerr(0, NULL);
  47.       return I_Fail;
  48.       }
  49.    
  50.    /*
  51.     * See what course the invocation is to take.
  52.     */
  53.    if (newargp->dword != D_Proc) {
  54.       /*
  55.        * Arg0 is not a procedure.
  56.        */
  57.       if (cvint(&newargp[0]) == T_Integer) {
  58.          /*
  59.       * Arg0 is an integer, select result.
  60.       */
  61.          i = cvpos(IntVal(newargp[0]), (word)nargs);
  62.          if (i == CvtFail || i > nargs)
  63.             return I_Fail;
  64.  
  65. #ifdef SCO_XENIX
  66.          p = newargp + i;
  67.          newargp[0] = *p;
  68. #else                    /* SCO_XENIX */
  69.          newargp[0] = newargp[i];
  70. #endif                    /* SCO_XENIX */
  71.  
  72.          sp = (word *)newargp + 1;
  73.          return I_Continue;
  74.          }
  75.       else {
  76.          /*
  77.       * See if Arg0 can be converted to a string that names a procedure
  78.       *  or operator.  If not, generate run-time error 106.
  79.       */
  80.          if (cvstr(&newargp[0],strbuf) == CvtFail || strprc(&newargp[0],
  81.             (word)nargs) == CvtFail) {
  82.                runerr(106, newargp);
  83.                return I_Fail;
  84.             }
  85.      }
  86.       }
  87.    
  88.    /*
  89.     * newargp[0] is now a descriptor suitable for invocation.  Dereference
  90.     *  the supplied arguments.
  91.     */
  92.    proc = (struct b_proc *)BlkLoc(newargp[0]);
  93.    if (proc->nstatic >= 0)    /* if negative, don't reference arguments */
  94.       for (i = 1; i <= nargs; i++)
  95.          if (DeRef(newargp[i]) == Error) {
  96.             runerr(0, NULL);
  97.             return I_Fail;
  98.             }
  99.       
  100.    /*
  101.     * Adjust the argument list to conform to what the routine being invoked
  102.     *  expects (proc->nparam).  If nparam is less than 0, the number of
  103.     *  arguments is variable. For functions (ndynam = -1) with a
  104.     *  variable number of arguments, nothing need be done.  For Icon procedures
  105.     *  with a variable number of arguments, arguments beyond abs(nparam) are
  106.     *  put in a list which becomes the last argument.  For fix argument
  107.     *  routines, if too many arguments were supplied, adjusting the stack
  108.     *  pointer is all that is necessary. If too few arguments were supplied,
  109.     *  null descriptors are pushed for each missing argument.
  110.     */
  111.    proc = (struct b_proc *)BlkLoc(newargp[0]);
  112.    nparam = (int)proc->nparam;
  113.    if (nparam >= 0) {
  114.       if (nargs > nparam)
  115.          newsp -= (nargs - nparam) * 2;
  116.       else if (nargs < nparam) {
  117.          i = nparam - nargs;
  118.          while (i--) {
  119.             *++newsp = D_Null;
  120.             *++newsp = 0;
  121.             }
  122.          }
  123.       nargs = nparam;
  124.  
  125. #ifdef TraceBack
  126.       xnargs = nargs;
  127. #endif                    /* TraceBack */
  128.  
  129.       }
  130.    else {
  131.       if (proc->ndynam >= 0) {
  132.          int lelems;
  133.      dptr llargp;
  134.  
  135.          if (nargs < abs(nparam) - 1) {
  136.             i = abs(nparam) - 1 - nargs;
  137.             while (i--) {
  138.                *++newsp = D_Null;
  139.                *++newsp = 0;
  140.                }
  141.             nargs = abs(nparam) - 1;
  142.             }
  143.  
  144.      lelems = nargs - (abs(nparam) - 1);
  145.          llargp = &newargp[abs(nparam)];
  146.          tended[1] = llargp[-1];
  147.          ntended = 1;
  148.  
  149.      Ollist(lelems, &llargp[-1]);
  150.  
  151.      llargp[0] = llargp[-1];
  152.      llargp[-1] = tended[1];
  153.          ntended = 0;
  154.          /*
  155.           *  Reload proc pointer in case Ollist triggered a garbage collection.
  156.           */
  157.          proc = (struct b_proc *)BlkLoc(newargp[0]);
  158.      newsp = (word *)llargp + 1;
  159.      nargs = abs(nparam);
  160.      }
  161.       }
  162.  
  163.    if (proc->ndynam < 0) {
  164.       /*
  165.        * A function is being invoked, so nothing else here needs to be done.
  166.        */
  167.       *n = nargs;
  168.       *cargp = newargp;
  169.  
  170.       sp = newsp;
  171.  
  172.  
  173.       if ((nparam == -1) || (proc->ndynam == -2))
  174.          return I_Vararg;
  175.       else
  176.          return I_Builtin;
  177.       }
  178.  
  179.    /*
  180.     * Make a stab at catching interpreter stack overflow.  This does
  181.     * nothing for invocation in a co-expression other than &main.
  182.     */
  183.    if (BlkLoc(k_current) == BlkLoc(k_main) &&
  184.       ((char *)sp + PerilDelta) > (char *)stackend) 
  185.          fatalerr(-301, NULL);
  186.    /*
  187.     * Build the procedure frame.
  188.     */
  189.    newpfp = (struct pf_marker *)(newsp + 1);
  190.    newpfp->pf_nargs = nargs;
  191.    newpfp->pf_argp = argp;
  192.    newpfp->pf_pfp = pfp;
  193.    newpfp->pf_ilevel = ilevel;
  194.    newpfp->pf_scan = NULL;
  195.  
  196.    newpfp->pf_ipc = ipc;
  197.    newpfp->pf_gfp = gfp;
  198.    newpfp->pf_efp = efp;
  199.  
  200.    argp = newargp;
  201.    pfp = newpfp;
  202.    newsp += Vwsizeof(*pfp);
  203.  
  204.    /*
  205.     * If tracing is on, use ctrace to generate a message.
  206.     */   
  207.    if (k_trace) {
  208.       k_trace--;
  209.       ctrace(&(proc->pname), nargs, &newargp[1]);
  210.       }
  211.    
  212.    /*
  213.     * Point ipc at the icode entry point of the procedure being invoked.
  214.     */
  215.    ipc.opnd = (word *)proc->entryp.icode;
  216.    efp = 0;
  217.    gfp = 0;
  218.  
  219.    /*
  220.     * Push a null descriptor on the stack for each dynamic local.
  221.     */
  222.    for (i = proc->ndynam; i > 0; i--) {
  223.       *++newsp = D_Null;
  224.       *++newsp = 0;
  225.       }
  226.  
  227.    sp = newsp;
  228.    k_level++;
  229.    return I_Continue;
  230. }
  231.